home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / newsgrp / group01b.txt / 000055_icon-group-sender_Thu Mar 8 08:01:52 2001.msg < prev    next >
Internet Message Format  |  2002-01-03  |  4KB
  1. Return-Path: <icon-group-sender>
  2. Received: (from root@localhost)
  3.     by baskerville.CS.Arizona.EDU (8.11.1/8.11.1) id f28F1mo23598
  4.     for icon-group-addresses; Thu, 8 Mar 2001 08:01:48 -0700 (MST)
  5. Message-Id: <200103081501.f28F1mo23598@baskerville.CS.Arizona.EDU>
  6. Date: Wed, 07 Mar 2001 20:40:02 -0600
  7. From: Viktors Berstis <viktors@berstis.com>
  8. X-Accept-Language: en
  9. To: Icon-group <icon-group@cs.arizona.edu>, snobol4@mercury.dsu.edu
  10. Subject: Re: New Scientist puzzle
  11. Errors-To: icon-group-errors@cs.arizona.edu
  12. Status: RO
  13. Content-Length: 2966
  14.  
  15. OK, I could no longer resist either.  Here is my solution in old
  16. fashioned SNOBOL4:
  17.  
  18.         d = LEN(1); DEFINE('c(x)'); &FULLSCAN = 1; t = TABLE(); i = 32
  19. a       j = 32
  20. b       ((i * i) ' ' (j * j)) 
  21. + ((d $ V d $ I d $ E d $ R) . vier ' ' (d $ N *E d $ U *N) . neun
  22. *c(1023456789)) . z :F(x)
  23.         a = a '=' z '.'
  24. r       a '=' (vier ' ' t<'v' vier> | t<'n' neun> ' ' neun) '.' = :S(r)
  25.         t<'n' neun> = LEN(4)
  26.         t<'v' vier> = LEN(4)
  27. x       j = j + 1 LT(j,99) :S(b)
  28.         i = i + 1 LT(i,99) :S(a)
  29.         OUTPUT = 'Answer' a :(END)
  30. c       x ANY(N E U V I R) = :S(c)
  31.         EQ(SIZE(x),4) :S(RETURN)F(FRETURN)
  32. END
  33.  
  34.  
  35. Also, here is a more general version for any two words, which don't need
  36. to be the same length along
  37. with comments (the above program can be derived from this one):
  38.  
  39. * Specify two words w1 and w2 which are both squares - need not be the
  40. same length
  41.         w1 = 'VIER'; w2 = 'NEUN'
  42. * Another puzzle:
  43. *       w1 = 'FIVE'; w2 = 'NINE'
  44.  
  45. * Shorthand for LEN(1)
  46.         dg = LEN(1)
  47. * Turn length heuristic off for pattern matching
  48.         &FULLSCAN = 1
  49. * Table to keep track of unique solutions
  50.         tb = TABLE()
  51. * Define the functions used
  52.         DEFINE('c(xx)')
  53.         DEFINE('bldpat(wd)')
  54. * Compute low and high limits of square roots to index thru for each
  55. word (funny char should be hat:)
  56.         lo1 = CONVERT(('1' DUPL('0',SIZE(w1) - 1)) ^ 0.5 + 1,'INTEGER')
  57.         hi1 = CONVERT(DUPL('9',SIZE(w1)) ^ 0.5,'INTEGER')
  58.         lo2 = CONVERT(('1' DUPL('0',SIZE(w2) - 1)) ^ 0.5 + 1,'INTEGER')
  59.         hi2 = CONVERT(DUPL('9',SIZE(w2)) ^ 0.5,'INTEGER')
  60. * Build checking patterns for both words
  61.         p1 = EVAL(bldpat(w1))
  62.         p2 = EVAL(bldpat(w2))
  63. * Start of two nested loops
  64.         j1 = lo1
  65. a       j2 = lo2
  66. * Test a pair of squares
  67. b       ((j1 * j1) ' ' (j2 * j2)) (p1 . vier ' ' p2 . neun
  68. *c(1023456789)) . zz :F(x)
  69. * Now need to test to see if solution unique
  70.         ans = ans '=' zz '.'
  71. * Remove prior candidates that use the same number for one word or the
  72. other
  73. r       ans '=' (vier ' ' tb<'v' vier> | tb<'n' neun> ' ' neun) '.' =
  74. :S(r)
  75. * Remember numbers encountered as candidates
  76.         tb<'v' vier> = LEN(SIZE(w2))
  77.         tb<'n' neun> = LEN(SIZE(w1))
  78. * Next iterations
  79. x       j2 = j2 + 1 LT(j2,hi2) :S(b)
  80.         j1 = j1 + 1 LT(j1,hi1) :S(a)
  81. * Print answer(s) if any
  82.         OUTPUT = 'Answer' ans :(END)
  83. * Function to check that two letters didn't get assigned to the same
  84. digit
  85. c       xx ANY(EVAL(cc)) = :S(c)
  86. * xx contains the digits not assigned to the letters, following checks
  87. count:
  88.         EQ(SIZE(xx),10 - SIZE(seen)) :S(RETURN)F(FRETURN)
  89. * Function to build test pattern for word wd
  90. bldpat  wd dg . let = :F(RETURN)
  91.         seen let :f(new)
  92.         bldpat = bldpat '*' let ' ' :(bldpat)
  93. * Remember letters we have already seen (matched)
  94. new     seen = seen let
  95. * cc will form argument for ANY in c function
  96.         cc = cc let ' '
  97.         bldpat = bldpat 'dg $ ' let ' ' :(bldpat)
  98.  
  99. END
  100.  
  101.  
  102. -Viktors
  103.